home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / perl / cterm.lha / cterm.pl < prev    next >
Perl Script  |  1993-08-13  |  2KB  |  69 lines
  1. #! /local/bin/perl
  2.  
  3. do 'cdefs.pl'  || die "cterm.pl can't include cdefs.pl\n" ;
  4. do 'curcon.pl' || die "cterm.pl can't include curcon.pl\n" ;
  5.  
  6. sub curFlush
  7.   { $oldpipe = $| ;
  8.     $| = 1 ;
  9.     print "" ;
  10.     $| = $oldpipe ;
  11.   }
  12.  
  13. sub frefresh { &refresh ; &curFlush if $flushOn ; }
  14.  
  15. sub ch2str
  16.   { local($c) = shift ;
  17.     if ( (31 < $c) && ($c < 128) )
  18.       { return(sprintf("%c", $c)) ; }
  19.     elsif ( defined $curkey{$c} )
  20.       { return($curkey{$c}) ; }
  21.     else
  22.       { return($c) ; }
  23.   }
  24.  
  25. sub getchint { return &ch2str(&getch) ; }
  26.  
  27. sub safeCterm { $safeCterm = 1 ; }
  28.  
  29. sub startCterm
  30.   { pipe(CURIN,PERLOUT) || die "cterm.pl can\'t create pipe CURIN/PERLOUT" ; 
  31.     pipe(PERLIN,CUROUT) || die "cterm.pl can\'t create pipe PERLIN/CUROUT" ; 
  32.  
  33.     $ctermPid = fork ;
  34.  
  35.     if ( $safeCterm ? ( $ctermPid != 0 ) : ( $ctermPid == 0 ) )
  36.       { close(PERLIN)  || die "cterm.pl can\'t close PERLIN" ;
  37.         close(PERLOUT) || die "cterm.pl can\'t close PERLOUT" ;
  38.         exec('cterm',fileno(CURIN),fileno(CUROUT),@_) ;
  39.         die 'cterm.pl can\'t exec cterm' ;
  40.       }
  41.     else
  42.       { close(CURIN)  || die "cterm.pl can\'t close CURIN" ;
  43.         close(CUROUT) || die "cterm.pl can\'t close CUROUT" ;
  44.         open(SAVESTDIN, "<&STDIN")  || die 'cterm.pl can\'t save STDIN' ;
  45.         open(SAVESTDOUT,">&STDOUT") || die 'cterm.pl can\'t save STDOUT' ;
  46.         open(STDIN, "<&PERLIN")     || die 'cterm.pl can\'t redirect STDIN' ;
  47.         open(STDOUT,">&PERLOUT")    || die 'cterm.pl can\'t redirect STDOUT' ;
  48.     $preCtermPipe = $| ;
  49.     $preCtermSelect = select(STDOUT) ;
  50.         $| = 0 ;
  51.     $flushOn = 0 ;
  52.       }
  53.   }
  54.  
  55. sub finishCterm
  56.   { &quitcterm ;
  57.     close(PERLOUT) ;
  58.     sleep 1 ;
  59.     close(PERLIN) ;
  60.     open(STDIN, "<&SAVESTDIN")  || die 'cterm.pl can\'t reredirect STDIN' ;
  61.     open(STDOUT,">&SAVESTDOUT") || die 'cterm.pl can\'t reredirect STDOUT' ;
  62.     close(SAVESTDIN) ;
  63.     close(SAVESTDOUT) ;
  64.     select($preCtermSelect) ;
  65.     $| = $preCtermPipe ;
  66.   }
  67.  
  68. 1;
  69.